home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / e_to_l / formset / formset.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  6.7 KB  |  200 lines
  1. {
  2.                                Saxman Software
  3.                         Programmer Productivity Series
  4.                              Delphi Custom Controls
  5.                       Copyright 1995, 1996 Jim Standley
  6.  
  7.                                 FormSet Control
  8. }
  9. unit Formset;
  10.  
  11. {--------------------------------} Interface {-------------------------------}
  12.  
  13. uses
  14.    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  15.    Forms, Dialogs, Tabs;
  16.  
  17. type
  18.  
  19.    TFTOpen  = (ftoSizeBookToPage, ftoSizePageToBook);
  20.    TFTClose = (ftcNeverRelease, ftcAlwaysRelease, ftcMaybeRelease);
  21.  
  22.    TFormTab = class
  23.       Form    : TForm;
  24.       OnOpen  : TFTOpen;
  25.       OnClose : TFTClose;
  26.    end;
  27.  
  28.    TTabLoadEvent = procedure(Sender   : TObject;
  29.                              TabIndex : Integer;
  30.                              FormTab  : TFormTab) of object;
  31.  
  32.    TFormSet = class(TTabSet)
  33.  
  34.    private
  35.       FOnClick       : TNotifyEvent;
  36.       FOnChange      : TTabChangeEvent;
  37.       FOnTabLoad     : TTabLoadEvent;
  38.       OldTabIndex    : Integer;
  39.       InternalChange : Boolean;
  40.       ParentHeight   : Integer;
  41.       ParentWidth    : Integer;
  42.       Procedure      TabClose(OldTabIndex: Integer);
  43.       Procedure      TabOpen(NewTabIndex: Integer);
  44.       Function       ConfigureTab(TabIndex: Integer): Boolean;
  45.       constructor    Create(Owner: TComponent); override;
  46.    protected
  47.       procedure Click; override;
  48.    public
  49.    published
  50.       property OnClick   : TNotifyEvent    read FOnClick   write FOnClick;
  51.       property OnChange  : TTabChangeEvent read FOnChange  write FOnChange;
  52.       property OnTabLoad : TTabLoadEvent   read FOnTabLoad write FOnTabLoad;
  53.    end;
  54.  
  55.    procedure Register;
  56.  
  57. {----------------------------} Implementation {------------------------------}
  58.  
  59.  
  60. {-------------------------------  Register  ---------------------------------}
  61. {  Called by the IDE Options/Install Components                              }
  62. procedure Register;
  63. begin
  64.    RegisterComponents('Samples', [TFormSet]);
  65. end;
  66.  
  67. {--------------------------------  Create  ----------------------------------}
  68. constructor TFormSet.Create;
  69. begin
  70.    inherited Create(Owner);
  71.    OldTabIndex    := TabIndex;
  72.    InternalChange := False;
  73. end;
  74.  
  75. {-----------------------------  ConfigureTab  -------------------------------}
  76. { If no FormTab object for this tab, create one.                             }
  77. { If FormTab.Form not known, call OnTabLoad to get one.                      }
  78. Function TFormSet.ConfigureTab;
  79. var
  80.    FormTab : TFormTab;
  81. begin
  82.    FormTab := Tabs.Objects[TabIndex] as TFormTab;
  83.    if not assigned(FormTab) then
  84.    begin
  85.       FormTab := TFormTab.Create;
  86.       Tabs.Objects[TabIndex] := FormTab;
  87.    end;
  88.    if not assigned(FormTab.Form) then
  89.       if assigned(FOnTabLoad) then
  90.          FOnTabLoad(Self,TabIndex,FormTab);
  91.    Result := assigned(FormTab.Form);
  92. end;
  93.  
  94. {--------------------------------  TabOpen  ---------------------------------}
  95. { Change size of notebook or page as needed.                                 }
  96. { Set required properties on child form.                                     }
  97. procedure TFormSet.TabOpen;
  98. var
  99.    FormTab : TFormTab;
  100.    Child   : TForm;
  101. begin
  102.    FormTab := Tabs.Objects[NewTabIndex] as TFormTab;
  103.    Child   := FormTab.Form;
  104.    if ParentHeight = 0 then ParentHeight := Parent.ClientHeight;
  105.    if ParentWidth  = 0 then ParentWidth  := Parent.ClientWidth;
  106.    if FormTab.OnOpen = ftoSizePageToBook then
  107.    begin
  108.       Parent.ClientHeight := ParentHeight;
  109.       Parent.ClientWidth  := ParentWidth;
  110.    end;
  111.    if FormTab.OnOpen = ftoSizeBookToPage then
  112.    begin
  113.       Parent.ClientHeight := Child.Height;
  114.       Parent.ClientWidth  := Child.Width;
  115.    end;
  116.    Child.Parent      := Parent;
  117.    Child.Align       := alClient;
  118.    Child.BorderStyle := bsNone;
  119.    Child.Visible     := True;
  120. end;
  121.  
  122. {-------------------------------  TabClose  ---------------------------------}
  123. { Release form if necessary                                                  }
  124. procedure TFormSet.TabClose;
  125. var
  126.    FormTab : TFormTab;
  127.    Child   : TForm;
  128. begin
  129.    if OldTabIndex < 0 then exit;
  130.    FormTab := Tabs.Objects[OldTabIndex] as TFormTab;
  131.    Child   := FormTab.Form;
  132.    if not assigned(FormTab) then
  133.       exit;
  134.    if FormTab.OnClose = ftcAlwaysRelease then
  135.    begin
  136.       Child.Parent := Nil;
  137.       Child.Release;
  138.       FormTab.Form := Nil;
  139.    end
  140.    else
  141.    begin
  142.       Child.Hide;
  143.       Child.Parent := Nil;
  144.    end;
  145. end;
  146.  
  147. {---------------------------------  Click  ----------------------------------}
  148. { This is the main driver                                                    }
  149. { TabSet has already changed the TabIndex                                    }
  150. { Undo the TabIndex change (causes recursion)                                }
  151. { If there was a tab/form displayed                                          }
  152. {    fire its CloseQuery                                                     }
  153. { If the form is not known for the new tab                                   }
  154. {    configure the new tab/form                                              }
  155. { Fire the OnChange event                                                    }
  156. { Close the old tab                                                          }
  157. { Open the new tab                                                           }
  158. { Redo the TabIndex change (causes recursion)                                }
  159. { Fire the OnClick event                                                     }
  160. {----------------------------------------------------------------------------}
  161. procedure TFormSet.Click;
  162. var
  163.    AllowChange : Boolean;
  164.    NewTabIndex : Integer;
  165.    FormTab     : TFormTab;
  166. begin
  167.    if InternalChange
  168.    or (TabIndex = OldTabIndex) then
  169.       exit;
  170.    InternalChange := True;                { Prevent too much recursion       }
  171.    NewTabIndex    := TabIndex;            { Temporarily undo TabIndex change }
  172.    TabIndex       := OldTabIndex;
  173.    AllowChange    := True;
  174.    if OldTabIndex >= 0 then
  175.    begin
  176.       FormTab := Tabs.Objects[OldTabIndex] as TFormTab;
  177.       if assigned(FormTab) then
  178.          if assigned(FormTab.Form) then
  179.             AllowChange := FormTab.Form.CloseQuery;
  180.    end;
  181.    if AllowChange then
  182.       AllowChange := ConfigureTab(NewTabIndex);
  183.    if AllowChange then
  184.       if assigned(FOnChange) then
  185.          FOnChange(Self,NewTabIndex,AllowChange);
  186.    if AllowChange then
  187.    begin
  188.       TabClose(OldTabIndex);
  189.       TabOpen(NewTabIndex);
  190.       TabIndex    := NewTabIndex;
  191.       OldTabIndex := NewTabIndex;
  192.       if assigned(FOnClick) then
  193.          OnClick(Self);
  194.    end;
  195.    InternalChange := False;
  196. end;
  197.  
  198. Initialization
  199. end.
  200.